home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
gt_power
/
escrub03.zip
/
EMERGE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-12-01
|
5KB
|
159 lines
{$C-,V-,K-,R-,U-}
{$G512,P512,D-}
(****************************************************************************)
(* *)
(* P & M Software Company *)
(* 3104 E. Camelback Rd. #503 *)
(* Phoenix, Arizona 85016 *)
(* *)
(* November 15, 1989 *)
(* *)
(****************************************************************************)
(* *)
(* USES MAX HEAP OF $2000 *)
(* *)
(****************************************************************************)
PROGRAM
emerge;
TYPE
CHARACTERS = STRING[255];
KEYTYPE = STRING[7];
CONST
high_values : KEYTYPE = #$FF#$FF#$FF#$FF#$FF#$FF#$FF;
VAR
infile1_name : CHARACTERS;
infile2_name : CHARACTERS;
outfile_name : CHARACTERS;
infile1,infile2 : text[$2000];
outfile : text[$2000];
infile1_rec : CHARACTERS;
infile1_key : KEYTYPE;
infile2_rec : CHARACTERS;
infile2_key : KEYTYPE;
error_stop : INTEGER;
PROCEDURE
UpString(VAR s : CHARACTERS);
VAR
i : INTEGER;
BEGIN
FOR i:=1 TO Length(s) DO
s[i] := upcase(s[i]);
END;
PROCEDURE
read_file_1;
BEGIN
IF (eof(infile1)) THEN BEGIN
infile1_key := high_values;
exit;
END;
readln(infile1,infile1_rec);
infile1_rec[9]:=' ';
infile1_key := copy(infile1_rec,1,7);
END;
PROCEDURE
read_file_2;
BEGIN
IF (eof(infile2)) THEN BEGIN
infile2_key := high_values;
exit;
END;
readln(infile2,infile2_rec);
infile2_rec[9]:=' ';
infile2_key := copy(infile2_rec,1,7);
END;
PROCEDURE
badfilename(VAR fn : CHARACTERS);
BEGIN
writeln('ERROR: cannot open ',fn,' for input');
END;
PROCEDURE
write_rec_out(k : INTEGER; VAR rc : CHARACTERS);
BEGIN
IF (k <> 0) THEN rc[9]:='·';
writeln(outfile,rc);
END;
LABEL
M1loop, M1read;
VAR
k : INTEGER;
knew : INTEGER;
BEGIN
lowvideo;
writeln('EMERGE Version 001');
writeln;
flush(output);
error_stop := 0;
IF (ParamCount < 2) THEN BEGIN
writeln('ERROR: too few command line arguments');
writeln(' The correct syntax is: EMERGE infile1 infile2 outfile');
flush(output);
halt(1);
END;
infile1_name := ParamStr(1);
UpString(infile1_name);
infile2_name := ParamStr(2);
UpString(infile2_name);
outfile_name := ParamStr(3);
UpString(outfile_name);
assign(infile1,infile1_name);
{$I-}
reset(infile1);
{$I+}
IF (IOresult <> 0) THEN BEGIN
badfilename(infile1_name);
error_stop := 1;
END;
assign(infile2,infile2_name);
{$I-}
reset(infile2);
{$I+}
IF (IOresult <> 0) THEN BEGIN
badfilename(infile2_name);
error_stop := 1;
END;
assign(outfile,outfile_name);
{$I-}
rewrite(outfile);
{$I+}
IF (IOresult <> 0) THEN BEGIN
writeln('ERROR: cannot open ',outfile_name,' for output');
error_stop := 1;
END;
flush(output);
IF (error_stop <> 0) THEN
halt(1);
read_file_1;
read_file_2;
WHILE ((infile1_key <> high_values) OR (infile2_key <> high_values)) DO BEGIN
IF (infile1_key < infile2_key) THEN BEGIN
write_rec_out(1,infile1_rec);
read_file_1;
goto M1loop;
END;
IF (infile1_key > infile2_key) THEN BEGIN
write_rec_out(0,infile2_rec);
read_file_2;
goto M1loop;
END;
knew:=0;
IF (infile1_rec <> infile2_rec) THEN
knew:=1;
write_rec_out(knew,infile1_rec);
M1read:
read_file_1;
read_file_2;
M1loop:
;
END;
close(infile1);
close(infile2);
close(outfile);
END.